home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
crtplus.zip
/
CRTPLUS.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1990-01-05
|
15KB
|
547 lines
{
CrtPlus.pas
1-5-90
Keyboard, cursor, and window enhancements to
Turbo Pascal 5.5's Crt unit.
Copyright 1990
John W. Small
All rights reserved
PSW / Power SoftWare
P.O. Box 10072
McLean, Virginia 22102 8072
If you acquired the CrtPlus ToolBox through 'shareware'
and find it useful, a registration fee of $20 would
be appreciated. Upon registion you will be sent source
code, manual on disk, the latest example programs, and
notices of updates.
Works consulted:
Norton, Peter. "Program's Guide to the IBM PC."
Bellevue, Washington: Microsoft Press, 1985.
Duncan, Ray. "Advanced MS DOS.", Bellevue Washington:
Microsoft Press, 1986.
Wilton, Richard. "Programmer's Guide to PC & PS/2
Video Systems.", Bellevue Washington:
Microsoft Press, 1987.
}
unit CrtPlus;
interface
uses dos, crt;
const
{
Ascii codes returned by CrtPlus.ReadKey, and
Crt.ReadKey (first call).
}
ESC = #27;
CR = #13;
Tab = #9;
BackSp = #8;
Space = #32;
DelCh = #127;
CtrlA = #1;
CtrlB = #2;
CtrlC = #3;
CtrlD = #4;
CtrlE = #5;
CtrlF = #6;
CtrlG = #7;
CtrlH = #8;
CtrlI = #9;
CtrlJ = #10;
CtrlK = #11;
CtrlL = #12;
CtrlM = #13;
CtrlN = #14;
CtrlO = #15;
CtrlP = #16;
CtrlQ = #17;
CtrlR = #18;
CtrlS = #19;
CtrlT = #20;
CtrlU = #21;
CtrlV = #22;
CtrlW = #23;
CtrlX = #24;
CtrlY = #25;
CtrlZ = #26;
{
Scan codes returned when (CrtPlus.ReadKey = #0)
via the global variable, CrtPlus.scan,
or by Crt.ReadKey (second call). Please note
that CrtPlus.ReadKey requires only one call
since the extended character set characters are
returned in CrtPlus.scan. CrtPlus.ReadKey is
faster than Crt.ReadKey since it is inline code
which also explains why I couldn't make the
keyboard into an object.
}
AltA = #30;
AltB = #48;
AltC = #46;
AltD = #32;
AltE = #18;
AltF = #33;
AltG = #34;
AltH = #35;
AltI = #23;
AltJ = #36;
AltK = #37;
AltL = #38;
AltM = #50;
AltN = #49;
AltO = #24;
AltP = #25;
AltQ = #16;
AltR = #19;
AltS = #31;
AltT = #20;
AltU = #22;
AltV = #47;
AltW = #17;
AltX = #45;
AltY = #21;
AltZ = #44;
Home = #71;
UpArr = #72;
PgUp = #73;
LArr = #75;
RArr = #77;
EndKey = #79;
DnArr = #80;
PgDn = #81;
InsKey = #82;
DelKey = #83;
CtrlHome = #119;
CtrlPgUp = #132;
CtrlLArr = #115;
CtrlRArr = #116;
CtrlEnd = #117;
CtrlPgDn = #118;
Alt1 = #120;
Alt2 = #121;
Alt3 = #122;
Alt4 = #123;
Alt5 = #124;
Alt6 = #125;
Alt7 = #126;
Alt8 = #127;
Alt9 = #128;
Alt0 = #129;
AltHyphen = #130;
AltEquals = #131;
CtrlPrtSc = #114;
ShiftTab = #15;
F1 = #59;
ShiftF1 = #84;
CtrlF1 = #94;
AltF1 = #104;
F2 = #60;
ShiftF2 = #85;
CtrlF2 = #95;
AltF2 = #105;
F3 = #61;
ShiftF3 = #86;
CtrlF3 = #96;
AltF3 = #106;
F4 = #62;
ShiftF4 = #87;
CtrlF4 = #97;
AltF4 = #107;
F5 = #63;
ShiftF5 = #88;
CtrlF5 = #98;
AltF5 = #108;
F6 = #64;
ShiftF6 = #89;
CtrlF6 = #99;
AltF6 = #109;
F7 = #65;
ShiftF7 = #90;
CtrlF7 = #100;
AltF7 = #110;
F8 = #66;
ShiftF8 = #91;
CtrlF8 = #101;
AltF8 = #111;
F9 = #67;
ShiftF9 = #92;
CtrlF9 = #102;
AltF9 = #112;
F10 = #68;
ShiftF10 = #93;
CtrlF10 = #103;
AltF10 = #113;
{ some BIOS' don't return these }
F11 = #133;
ShiftF11 = #135;
CtrlF11 = #137;
AltF11 = #139;
F12 = #134;
ShiftF12 = #136;
CtrlF12 = #138;
AltF12 = #140;
{
BIOS keyboard shift constants used to mask value
returned by CrtPlus.ReadShift, e.g.
if CapsLock and ReadShift then ...
}
InsertState = 128;
CapsLock = 64;
NumLock = 32;
ScrollLock = 16;
AltPressed = 8;
CtrlPressed = 4;
LeftShiftPressed = 2;
RightShiftPressed = 1;
ShiftPressed = 3;
type
{
TextFrameChars are the IBM extended character
set characters used to draw line boxes. Imagine
a box with a cross inside, then the characters
needed to draw this are typified by the corners
of the box, the four points the cross touches
the outside box, and the center of the cross.
Indices into textFrameChars are thus:
rt = top-right corner of the box,
mm = middle-middle or center of cross,
mb = middle-bottom where cross touches
the bottom of the box
etc.
}
textFrameChars = (v,h,lt,rt,rb,lb,ml,mt,mr,mb,mm);
textFrame = array[textFrameChars] of char;
const
{
Text Box Drawing Characters:
svsh = single vert., single horizonal lines
dvdh = double vert., double horizonal lines
etc.
}
svsh : textFrame =
#179#196#218#191#217#192#195#194#180#193#197;
svdh : textFrame =
#179#205#213#184#190#212#198#209#181#207#216;
dvsh : textFrame =
#186#196#214#183#189#211#199#210#182#208#215;
dvdh : textFrame =
#186#205#201#187#188#200#204#203#185#202#206;
type
{ Cursor object for turning on/off cursor, etc. }
CursorShape = object { CURSORSHAPE }
OrigShape, prevShape : word;
procedure init; { Do not call! }
function getShape : word;
procedure putShape (shape : word);
function defaultShape : word;
procedure off;
procedure on;
procedure block;
procedure normal;
procedure restore;
procedure done;
end;
{ Object for storing text screen images. }
TextImage = object { TEXTIMAGE }
ImageMin, ImageMax : word;
image : ^word;
procedure init (x1, y1, x2, y2 : byte);
procedure done
end;
{
Turbo Pascal's text-screen state, i.e. current
window, text attribute, cursor position, and
cursor shape.
}
TurboWindow = object { TURBOWINDOW }
WindMin, WindMax : word;
textAttr, wherex, wherey : byte;
curshape : word;
procedure save;
procedure restore;
end;
{
TextWindow is a direct replacement for Turbo
Pascal's window procedure. It sets the current
window, like Turbo Pascal does, but it also
saves the shadow beneath the window and the
screen state before the window was called. When
done is called the window is removed and the
screen returned to its previous state. Call
TxtScr.TextMode() instead of Crt.TextMode()
when changing video modes to insure proper
operation!
}
TextWindow = object { TEXTWINDOW }
shadow : TextImage;
prevWind : TurboWindow;
procedure window (x1, y1, x2, y2 : byte);
procedure done
end;
{
The TextScreen object provides enhancements to
Turbo Pascal's Crt unit's treatment of the text
screen. The TextScreen object works in all the
text modes supported by Turbo Pascal including
43/50 line modes! It also respects the setting
of Crt.CheckSnow and Crt.DirectVideo! The only
restriction is that your call TxtScr.TextMode()
instead of Crt.TextMode() when changing video
modes.
}
TextScreen = object { TEXTSCREEN }
OrigMode, dim, vseg, vport : word;
prevTextAttr : byte;
state : TextWindow; { used by save and restore }
CheckSnow, DirectVideo : boolean;
vmode : integer;
procedure init; { Do not call! }
{ Use to save screen during exec calls. }
procedure save;
procedure restore;
{ Use instead of Crt.TextMode(). }
procedure TextMode (mode : integer);
function VideoMode : integer;
function IsTextMode : boolean;
function IsColorMode : boolean;
{ Use to extend Low/Norm/High video. }
procedure ReverseVideo;
procedure SetVideo (fgrd, bgrd : byte);
procedure BlinkVideo;
procedure UnblinkVideo;
procedure RestoreVideo;
{ Use to construct TextAttr bytes. }
function rvideo (attr : byte) : byte;
function svideo (fgrd, bgrd : byte) : byte;
function bvideo (attr : byte) : byte;
function ubvideo (attr : byte) : byte;
function lvideo (attr : byte) : byte;
function hvideo (attr : byte) : byte;
{ Use to save and restore screen images. }
procedure getText (var ti : TextImage);
procedure putText (var ti : TextImage);
{
Use instead of WhereX and WhereY for
screen coordinates.
}
function scrX : byte;
function scrY : byte;
{ Use to write to screen without scroll/wrap. }
procedure scrWrite (
x, y, maxLen, attr : byte;
var str : string);
procedure scrFill (
x, y, len, attr : byte; ch : char);
{ Note: if ch = #0 then fill attr only }
procedure scrHorzLn (
left, row, right, attr: byte; ch: char);
procedure scrVertLn (
col, top, bottom, attr: byte; ch: char);
procedure scrBox (
x1, y1, x2, y2, attr: byte;
var tf : textFrame);
{
Use to write to current crt.window without
scroll/wrap
}
procedure windWrite (var str : string);
procedure windLightBar (x, y, len, attr : byte);
procedure windColor (fgrd, bgrd : byte);
{ Call to restore original crt mode. }
procedure done
end;
{
FramedTextWindow is a popup window object drived
from the TextWindow object. This window has an
optional border, title and/or footer, and scroll
bar(s). This object provides an example of how
the TextWindow object is extensible and can be
used as a base class object to construct any
type of text window! Call TxtScr.TextMode()
instead of Crt.TextMode() when changing video
modes to insure proper operation!
}
{ FRAMEDTEXTWINDOW }
FramedTextWindow = object(TextWindow)
procedure window (x1, y1, x2, y2 : byte);
procedure frame (
attr : byte; var f : textFrame);
procedure titleFooter (
title : boolean; attr : byte; str : string);
procedure scrollBar (
vert : boolean; attr : byte;
var f : textFrame; p, maxp : integer);
{ Uses procedure TextWindow.done; }
end;
{
ShadowTextWindow is yet another popup window
object drived from the TextWindow object. This
window has an title bar and shadow beneath the
window. This object is yet another extension to
the TextWindow object. Call TxtScr.TextMode()
instead of Crt.TextMode() when changing video
modes to insure proper operation!
}
{ SHADOWWINDOW }
ShadowTextWindow = object(TextWindow)
procedure window(x1, y1, x2, y2 : byte);
procedure title(attr : byte; str : string);
{ Uses procedure TextWindow.done; }
end;
var
cursor : CursorShape; { TEXT CURSOR OBJECT }
TxtScr : TextScreen; { TEXT SCREEN OBJECT }
scan : char; { KEYBOARD SCAN CODE }
{ set by CrtPlus.ReadKey }
{ READ CHARACTER FROM KEYBOARD }
function ReadKey : char;
inline($30/$E4/ { xor ah,ah }
$CD/$16/ { int $16 }
$88/$26/CrtPlus.scan/ { mov scan,ah }
$30/$E4); { xor ah,ah }
{ IS CHARACTER WAITING? }
function KeyPressed : boolean;
inline($B4/$01/ { mov ah,1 }
$CD/$16/ { int $16 }
$9C/ { pushf }
$58/ { pop ax }
$25/>$01); { and ax,1 }
{ FLUSH KEYBOARD BUFFER }
procedure ClrKey;
{ READ KEYBOARD SHIFT STATE }
function ReadShift : byte;
inline($B4/$02/ { mov ah,2 }
$CD/$16/ { int $16 }
$30/$E4); { xor ah,ah }